{
 ResEdit.pas
   'PP applet' for iziBasic
   Version 1.01 - December 16, 2005
   by Laurent Duveau
     Web Site = http://www.aldweb.com
     e-Mail   = info@aldweb.com


--------------------
What is ResEdit.pas?
--------------------

ResEdit.pas is a fully featured 'PP applet' for iziBasic which
is made to open/create/delete/modify/close resource files and
resources within these files.

This 'PP applet' can be used as is in your iziBasic projects.
Please give a look to the ResEdit.ibas sample program source
code to see an example of how to access it.


-----------------------
How to use ResEdit.pas?
-----------------------

SYNTAX

output$ = CALLPP$(100,input$)
 input$ : "NumFunction[1 Char]"+"Parameters[see details below]"
 output$: "1" if success,
          "0" otherwise (except for NumFunction #8, see below)


FUNCTIONS

Check if RsrcDB exists
 NumFunction: "0"
 Parameters : "RsrcFileName"

Delete RsrcDB
 NumFunction: "1"
 Parameters : "RsrcFileName"

Create RsrcDB
 NumFunction: "2"
 Parameters : "RsrcFileType[4 Chars]"+"RsrcFileCreator[4 Chars]"+"RsrcFileName"

Register Working Rsrc
 NumFunction: "3"
 Parameters : "RsrcType[4 Chars]"+"RsrcID[4 NumChars]"+"RsrcFileName"

Check if Rsrc exists
 NumFunction: "4" (requires Working Rsrc to be defined)
 Parameters : none

Delete Rsrc
 NumFunction: "5" (requires Working Rsrc to be defined)
 Parameters : none

Create Rsrc or Append to existing Rsrc
 NumFunction: "6" (requires Working Rsrc to be defined)
 Parameters : "StartPos[4 NumChars]"+"SomeData[<=58 Chars]"

Copy Rsrc from File
 NumFunction: "7" (requires Working Rsrc to be defined, which is
                   the Target Rsrc parametrization for this function)
 Parameters : "FromRsrcID[4 NumChars]"+"FromRsrcFileName"
 
Read Rsrc 'piece' (up to 63 characters)
 NumFunction: "8" (requires Working Rsrc to be defined)
 Parameters : "StartPos[4 NumChars]"
 Output     : "" if error or read Char #1 is CHR$(0),
              Up to 63 characters otherwise (until CHR$(0) is encountered)

Draw a Rsrc Bitmap
 NumFunction: "9" (requires Working Rsrc to be defined)
 Parameters : "XPos[3 NumChars]"+"YPos[3 NumChars]"


-------------------------------
Parametrization and integration
in an iziBasic project
-------------------------------

Step #1: Replace the 'LDRE' CreatorID in the first line of the
         source code below to the CreatorID defined in your
         iziBasic source code (see CREATORID compiling directive)
         Also replace the 'ResEdit' label in the second line
         to the name of your application (the part of the iziBasic
         source code file name prior to the '.ibas' extension)

Step #2: Compile your iziBasic project

Step #3: Compile this 'PP applet'
}

{$code appl,LDRE,code,100}
program ResEdit;
type iBasFunType=function(S:string):string;
var iBasCallPP:iBasFunType;


// -----------------------
// Palm OS API definitions
// -----------------------

{$i PalmAPI.pas}


// -------------------------
// Global variables
// (up to 256 bytes)
// -------------------------

var
 G_RsrcType:UInt32;     // 4 bytes
 G_RsrcNum:UInt16;      // 2 bytes
 G_RsrcFileName:string; // 64 bytes


// -------------------------
// General purpose functions
// -------------------------

function Max(A,B:Integer):Integer;
begin
 if A>B then Max:=A else Max:=B;
end;


function Min(A,B:Integer):Integer;
begin
 if A<B then Min:=A else Min:=B;
end;


function CutString(const sMyString:String;iStartString,iEndString:UInt8):string;
var
 sResult2:String;
 i:UInt8;
begin
 sResult2:='';
 for i:=Max(iStartString,1) to Min(iEndString,Length(sMyString)) do
  sResult2:=sResult2+sMyString[i];
 CutString:=sResult2;
end;


function IntToString(N:integer):string;
var
 S:string;
begin
 StrIToA(S,N);
 IntToString:=S;
end;


function String4ToUInt32(const sMyString:string):UInt32;
begin
 String4ToUInt32:=Ord(sMyString[4])+256*Ord(sMyString[3])+65536*Ord(sMyString[2])+16777216*Ord(sMyString[1]);
end;


// ---------------------------
// RsrcDB management functions
// ---------------------------

function ExistDbRsrc(const ResTarget:string):boolean;
begin
 if DmFindDatabase(0,ResTarget)>0 then
  ExistDbRsrc:=true
 else
  ExistDbRsrc:=false;
end;


function DeleteDbRsrc(const ResTarget:string):boolean;
var
 IdTarget:LocalID;
begin
 IdTarget:=DmFindDatabase(0,ResTarget);
 if IdTarget=0 then
  DeleteDbRsrc:=false
 else
  if DmDeleteDatabase(0,IdTarget)=0 then
   DeleteDbRsrc:=true
  else
   DeleteDbRsrc:=false;
end;


function CreateDbRsrc(const ResType,ResCreator,ResName:string):boolean;
var
 dabID:LocalID;
 attributes:UInt16;
begin
 if DmCreateDatabase(0,ResName,String4ToUInt32(ResCreator),String4ToUInt32(ResType),true)>0 then
  CreateDbRsrc:=false
 else begin
  dabID:=DmFindDatabase(0,ResName);
  if dabID=0 then
   CreateDbRsrc:=false
  else
   if DmDatabaseInfo(0,dabID,nil,attributes,nil,nil,nil,nil,nil,nil,nil,nil,nil)>0 then
    CreateDbRsrc:=false
   else begin
    attributes:=attributes or 8;
    if DmSetDatabaseInfo(0,dabID,nil,attributes,nil,nil,nil,nil,nil,nil,nil,nil,nil)>0 then
     CreateDbRsrc:=false
    else
     CreateDbRsrc:=true;
   end;
 end;
end;


// -------------------------
// Rsrc management functions
// -------------------------

function RegisterWorkingRes(const ResType,ResNum,ResFileName:string):boolean;
begin
 G_RsrcType:=String4ToUInt32(ResType);
 G_RsrcNum:=StrAToI(ResNum);
 G_RsrcFileName:=ResFileName;
 RegisterWorkingRes:=ExistDbRsrc(ResFileName);
end;


function ExistRes:boolean;
var
 gDataBase:DmOpenRef;
 IDDataBase:LocalID;
begin
 IDDataBase:=DmFindDatabase(0,G_RsrcFileName);
 if IDDataBase=0 then
  ExistRes:=false
 else begin
  gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadOnly);
  if DmFindResource(gDataBase,G_RsrcType,G_RsrcNum,nil)=65535 then
   ExistRes:=false
  else
   ExistRes:=true;
  DmCloseDatabase(gDataBase);
 end;
end;


function DeleteRes:boolean;
var
 gDataBase:DmOpenRef;
 IDDataBase:LocalID;
 IndexRes:UInt16;
begin
 IDDataBase:=DmFindDatabase(0,G_RsrcFileName);
 if IDDataBase=0 then
  DeleteRes:=false
 else begin
  gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadWrite);
  IndexRes:=DmFindResource(gDataBase,G_RsrcType,G_RsrcNum,nil);
  if IndexRes=65535 then
   DeleteRes:=false
  else
   if DmRemoveResource(gDataBase,IndexRes)>0 then
    DeleteRes:=false
   else
    DeleteRes:=true;
  DmCloseDatabase(gDataBase);
 end;
end;


function CreateOrAppendRes(const StartPos,ResData:string):boolean;
const
 MyMegaStringSize=1023; // up to 1KB resource
type
 MyMegaStringType=array[0..MyMegaStringSize] of char;
 MyMegaStringTypePtr=^MyMegaStringType;
var
 gDataBase:DmOpenRef;
 IDDataBase:LocalID;
 MyMegaString:MyMegaStringType;
 MyMegaStringPtr:MyMegaStringTypePtr;
 MySTRH:Memhandle;
 MySTRP:MemPtr;
 MySize,IndexRes,I,J:UInt16;
 MyChar:char;
begin
 IDDataBase:=DmFindDataBase(0,G_RsrcFileName);
 if IDDataBase=0 then
  CreateOrAppendRes:=false
 else begin
  MySize:=0;
  gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadWrite);
  MySTRH:=DmGetResource(G_RsrcType,G_RsrcNum);
  if MySTRH<>nil then begin
   MyMegaStringPtr:=MemHandleLock(MySTRH);
   MyMegaString:=MyMegaStringPtr^;
   MySize:=MemHandleSize(MySTRH);
   MemHandleUnlock(MySTRH);
   DmReleaseResource(MySTRH);
   IndexRes:=DmFindResource(gDataBase,G_RsrcType,G_RsrcNum,nil);
   DmRemoveResource(gDataBase,IndexRes);
  end;
  for I:=MySize to MyMegaStringSize do
   MyMegaString[I]:=Chr(0);
  I:=0;
  J:=StrAToI(StartPos)-1;
  MySize:=Max(MySize,I+J+1);
  while (I<Length(ResData)) and (I+J<MyMegaStringSize) do begin
   MyMegaString[I+J]:=ResData[I+1];
   MySize:=Max(MySize,I+J+1);
   I:=I+1;
  end;
  MySize:=MySize*SizeOf(MyChar);
  MySTRH:=DmNewResource(gDataBase,G_RsrcType,G_RsrcNum,MySize);
  if MySTRH=nil then
   CreateOrAppendRes:=false
  else begin
   MySTRP:=MemHandleLock(MySTRH);
   MyMegaStringPtr:=@MyMegaString;
   CreateOrAppendRes:=(DmWrite(MySTRP,0,MyMegaStringPtr,MySize)=0);
   MemHandleUnlock(MySTRH);
   DmReleaseResource(MySTRH);
  end;
  DmCloseDatabase(gDataBase);
 end;
end;


function ReadRes(const StartPos:string):string;
const
 MyMegaStringSize=1023; // up to 1KB resource
type
 MyMegaStringType=array[0..MyMegaStringSize] of char;
 MyMegaStringTypePtr=^MyMegaStringType;
var
 MyMegaString:MyMegaStringType;
 MyMegaStringPtr:MyMegaStringTypePtr;
 MySTRH:Memhandle;
 gDataBase:DmOpenRef;
 IDDataBase:LocalID;
 MySmallString:string;
 MySize,I,J:UInt16;
begin
 MySmallString:='';
 MyMegaString[0]:=Chr(0);
 IDDataBase:=DmFindDataBase(0,G_RsrcFileName);
 if IDDataBase<>0 then begin
  gDataBase:=DmOpenDatabase(0,IDDataBase,dmModeReadOnly);
  MySTRH:=DmGetResource(G_RsrcType,G_RsrcNum);
  if MySTRH<>nil then begin
   MyMegaStringPtr:=MemHandleLock(MySTRH);
   MyMegaString:=MyMegaStringPtr^;
   MySize:=MemHandleSize(MySTRH);
   MemHandleUnlock(MySTRH);
   DmReleaseResource(MySTRH);
   I:=0;
   J:=StrAToI(StartPos)-1;
   MySize:=Min(MySize,MyMegaStringSize);
   while (I<63) and (I+J<MySize) do
    if MyMegaString[I+J]<>Chr(0) then begin
     MySmallString:=MySmallString+MyMegaString[I+J];
     I:=I+1;
    end
    else
     I:=63;
  end;
  DmCloseDatabase(gDataBase);
 end;
 ReadRes:=MySmallString;
end;


Function CopyRes(const FromRsrcID,FromFile:string):boolean;
var
 IDDataBase,IdTarget:LocalID;
 RefFrom,RefTarget:DmOpenRef;
 MyResH,h:Memhandle;
 MyResP,p:MemPtr;
 MySize:UInt16;
begin
 IdTarget:=DmFindDatabase(0,G_RsrcFileName);
 if FromFile<>G_RsrcFileName then
  IDDataBase:=DmFindDatabase(0,FromFile)
 else
  if StrAToI(FromRsrcID)<>G_RsrcNum then
   IDDataBase:=1
  else
   IDDataBase:=0;
 if (IDDataBase=0) or (IdTarget=0) then
  CopyRes:=false
 else begin
  RefTarget:=DmOpenDatabase(0,IdTarget,dmModeReadWrite);
  if FromFile<>G_RsrcFileName then
   RefFrom:=DmOpenDatabase(0,IDDataBase,dmModeReadOnly)
  else
   RefFrom:=RefTarget;
  if (DmFindResource(RefTarget,G_RsrcType,G_RsrcNum,nil)<>65535) or
     (DmFindResource(RefFrom,G_RsrcType,StrAToI(FromRsrcID),nil)=65535) then
   CopyRes:=false
  else begin
   MyResH:=DmGetResource(G_RsrcType,StrAToI(FromRsrcID));
   MyResP:=MemHandleLock(MyResH);
   MySize:=MemHandleSize(MyResH);
   h:=DmNewResource(RefTarget,G_RsrcType,G_RsrcNum,MySize);
   p:=MemHandleLock(h);
   CopyRes:=(DmWrite(p,0,MyResP,MySize)=0);
   MemHandleUnlock(h);
   DmReleaseResource(h);
   MemHandleUnlock(MyResH);
   DmReleaseResource(MyResH);
  end;
  DmCloseDatabase(RefTarget);
  if FromFile<>G_RsrcFileName then
   DmCloseDatabase(RefFrom);
 end;
end;


function DrawBitmapRes(const X,Y:string):boolean;
var
 gDatabase:DmOpenRef;
 IDDataBase:LocalID;
 pBitmap:BitmapPtr;
 hBitmap:MemHandle;
begin
 if G_RsrcType<>String4ToUInt32('Tbmp') then
  DrawBitmapRes:=false
 else begin
  IDDataBase:=DmFindDataBase(0,G_RsrcFileName);
  if IDDataBase=0 then
   DrawBitmapRes:=false
  else begin
   gDataBase:=DmOpenDatabase(0,IDDatabase,dmModeReadOnly);
   hBitmap:=DmGet1Resource(G_RsrcType,G_RsrcNum);
   if hBitmap<>nil then begin
    pBitmap:=MemHandleLock(hBitmap);
    WinDrawBitmap(pBitmap,StrAToI(X),StrAToI(Y));
    MemHandleUnlock(hBitmap);
    DmReleaseResource(hBitmap);
    DrawBitmapRes:=true;
   end
   else
    DrawBitmapRes:=false;
   DmCloseDatabase(gDataBase);
  end;
 end;
end;


// ------------------
// PP applet function
// ------------------

function CallPP(S:string):string;
var
 WhatToDo:byte;
 ReportDone:boolean;
begin
 WhatToDo:=StrAToI(S[1]);
 case WhatToDo of
  0: ReportDone:=ExistDbRsrc(CutString(S,2,63));
  1: ReportDone:=DeleteDbRsrc(CutString(S,2,63));
  2: ReportDone:=CreateDbRsrc(CutString(S,2,5),CutString(S,6,9),CutString(S,10,63));
  3: ReportDone:=RegisterWorkingRes(CutString(S,2,5),CutString(S,6,9),CutString(S,10,63));
  4: ReportDone:=ExistRes;
  5: ReportDone:=DeleteRes;
  6: ReportDone:=CreateOrAppendRes(CutString(S,2,5),CutString(S,6,63));
  7: ReportDone:=CopyRes(CutString(S,2,5),CutString(S,6,63));
  8: CallPP:=ReadRes(CutString(S,2,5));
  9: ReportDone:=DrawBitmapRes(CutString(S,2,4),CutString(S,5,7));
  else
   ReportDone:=false;
 end;
 if WhatToDo<>8 then
  CallPP:=IntToString(Ord(ReportDone));
end;


begin
 iBasCallPP:=CallPP;
end.

// For debugging purposes
// FrmCustomAlert(1200,' '+Chr(10),'"'+''+'"',' ');
